home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
Modes
/
sqlMode.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
5KB
|
141 lines
#############################################################################
# FILE: sql.tcl
#----------------------------------------------------------------------------
# AUTHOR: Joel D. Elkins
# of New Media, Inc.
# 200 South Meridian, Ste. 220
# Indianapolis, IN 46225
#
# internet: jdelkins@iquest.net (preferred)
# compuserve: 72531,314
# AOL: jdelkins
#
# Copyright © 1994-1995 by Joel D. Elkins
# All rights reserved.
#############################################################################
#
# Alpha mode for SQL and Oracle's PL/SQL programming language
# Converts SQL and PL/SQL keywords to uppercase on the fly and colorizes
#
#############################################################################
# HISTORY
#
# modified who rev reason
# -------- --- --- ------
# 7/29/94 JDE 1.0 Original
# 2/8/95 JDE 1.1 Added electUpper for tab, cr, and ';'
#############################################################################
if {$startingUp} {
#===============================================================================
# PL/SQL mode by Joel D. Elkins
addMode SQL dummySQL { *.sql *.SQL *.pkg} {}
return
}
proc dummySQL {} {}
#############################################################################
# PL/SQL mode by Joel D. Elkins
#############################################################################
lappend modes SQL
set modeMenus(SQL) { }
set dummyProc(SQL) dummySQL
newModeVar SQL elecRBrace {0} 1
newModeVar SQL electricSemi {1} 1
newModeVar SQL wordBreak {(\$)?\w+} 0
newModeVar SQL prefixString {--} 0
newModeVar SQL elecLBrace {0} 1
newModeVar SQL wordWrap {0} 1
newModeVar SQL funcExpr {(PROCEDURE|FUNCTION)[ \t]+(\w+)} 0
newModeVar SQL wordBreakPreface {[^a-zA-Z0-9_\$]} 0
set sqlKeywords {
ABORT ACCEPT ACCESS ALTER AND ARRAY ARRAYLEN AS ASSERT AT AVG BEGIN BETWEEN BODY
CASE COLUMNS COMMIT CONSTANT COUNT CREATE CURSOR DECLARE DEFAULT DEFINITION
DELETE DESC DISPOSE DISTINCT DO DROP ELSE ELSIF END ENTRY EXCEPTION EXISTS EXIT
FALSE FETCH FOR FROM FUNCTION GOTO IF IN INSERT INTERSECT INTO IS LIKE LOOP MAX MIN
MINUS MOD NEW OF ON OPEN OR OUT PACKAGE PARTITION POSITIVE PRAGMA PRIVATE
PROCEDURE PUBLIC RANGE RECORD REM REPLACE RETURN ROLLBACK ROWTYPE RUN SAVEPOINT
SELECT SET SIZE START STDDEV SUM THEN TO TYPE UNION UNIQUE UPDATE USE VALUES
VARIANCE WHEN WHERE WHILE WITH XOR
}
### Just colorize uppercase keywords
# abort accept access alter and array arraylen as assert at avg begin between body
# case columns commit constant count create cursor declare default definition
# delete desc dispose distinct do drop else elsif end entry exception exists exit
# false fetch for from function goto if in insert intersect into is like loop max min
# minus mod new of on open or out package partition positive pragma private
# procedure public range record rem replace return rollback rowtype run savepoint
# select set size start stddev sum then to type union unique update use values
# variance when where while with xor
###
regModeKeywords -e {--} -b {/*} {*/} -c red -k blue SQL $sqlKeywords
unset sqlKeywords
#================================================================================
catch {unset plSqlKeywords}
lappend plSqlKeywords \
abort accept access alter and array arraylen as assert at avg begin between body \
case columns commit constant count create cursor declare default definition \
delete desc dispose distinct do drop else elsif end entry exception exists exit \
false fetch for from function goto if in insert intersect into is like loop max min \
minus mod new of on open or out package partition positive pragma private \
procedure public range record rem replace return rollback rowtype run savepoint \
select set size start stddev sum then to type union unique update use values \
variance when where while with xor
proc electUpper {char} {
global plSqlKeywords
set a [getPos]
backwardWord
set b [getPos]
#make sure we're not in a comment
beginningOfLine
set commentSearch {(^[ \t]*rem[ \t]+)|(^[ \t]*REM[ \t]+)|--}
if {[catch {search -r 1 -f 1 -l $b -- $commentSearch [getPos]}] != 0} {
#if not, make the word uppercase if it's a keyword
set cmd [getText $b $a]
goto $b
if {[lsearch -exact $plSqlKeywords $cmd] >= 0} {
upcaseWord
}
}
goto $a
if { 0 == [string compare $char "\r"] } {
carriageReturn
} else {
insertText $char
}
}
bind '\ ' {electUpper "\ "} "SQL"
bind '\t' {electUpper "\t"} "SQL"
bind '\r' {electUpper "\r"} "SQL"
bind '\;' {electUpper "\;"} "SQL"
proc SQLMarkFile {} {
global SQLmodeVars
set pos 0
while {![catch {search -f 1 -r 1 -m 0 -i 0 $SQLmodeVars(funcExpr) $pos} res]} {
set start [lindex $res 0]
set end [lindex $res 1]
set text [lindex [getText $start $end] 1]
set pos $end
set inds($text) "$start $end"
}
if {[info exists inds]} {
foreach f [lsort [array names inds]] {
setNamedMark $f [lineStart [lineStart [lindex $inds($f) 0]] - 1] [lindex $inds($f) 0] [lindex $inds($f) 1]
}
}
}